TITLE	BUFFER;  DOROTHY BENDER ****** GARPLY *******

;  ROUTINE TO READ THE OUTPUT FROM THE MUSIC
;  PROGRAM AND CALL THE D-A CONVERTER TO PLAY.
;  
;  THE NAME OF THE FILE TO BE INPUTTED IS 'MUSIC',
;  THE FIRST RECORD OF WHICH CONTAINS THE
;  NUMBER OF WORDS OF DATA IN THE ENTIRE DISK FILE.

	EXTERNAL CORGET,FSINIT
A   ←   1     ;WORK
B   ←   2     ;WORK
P←17
BLOCK←4
SIZE←5
RET ←   3     ;RETURN ACCUMULATOR
PLN←20
PDL: BLOCK PLN

;;BUFSIZ ←=20224   
↓DSKCHN ←1             ;DISK CHANNEL FOR INPUT
↓ADCHN  ←2             ;D-A CHANNEL FOR OUTPUT

	OPDEF	READCH [51B8]
        OPDEF   MESSAGE[51B8!3B12]

BEG:	CALLI	0,0         ;RESET I/O DEVICES
	MOVE P,[IOWD PLN,PDL]
	PUSHJ P,FSINIT
	MOVEI SIZE1←=20224
	PUSHJ P,CORGET
	HALT,
	SUBI BLOCK,1
	MOVEM BLOCK, LOOP+1

	PUSHJ P,CORGET
	HALT,
	SUBI BLOCK,1
	MOVEM BLOCK, LOOP+4

 	OPEN 	DSKCHN,[17  ;MODE
		'DSK   '    ;DEVICE NAME
 		0]          ;NO BUFFER HEADERS
	HALT	BEG         ;RESTART IF DEVICE IS UNAVAILABLE

 	SETZM	FILBLK+3    ;FOR RESTART
 	SETZM	FILBL2+3    ;FOR RESTART
LX:	MESSAGE [ASCIZ/
  TYPE `P' TO PLAY FROM DISK, `C' TO COPY TAPE TO DISK.
/]
	readch a
	cain a,"C"
	jrst start
	caie a,"P"
	jrst lx
	skipe filblk+3	;is this first time through ?
	jrst pla2	;No. Parameters already set up.
	;FIND OUT NUMBER OF CHANNELS AND
	;THE SPEED.

	MESSAGE	[ASCIZ/HOW MANY CHANNELS?/]
	READCH	A
	SUBI	A,"0"+1		;CONVERT TO BINR AND ADD 1
	DPB	A,[POINT 2,OUTBIT,26]

	MESSAGE [ASCIZ/WHAT IS THE SPEED?/]
	READCH  A
	SUBI	A,"0"
	DPB	A,[POINT 3,OUTBIT,32]

PLA2:	SETZM FILBLK+3
	SETZM FILBL2+3
	LOOKUP	DSKCHN,FILBLK
	SKIPA			;CAN'T FIND MUSIC.MUS
	JRST XOPEN		;FOUND IT
	LOOKUP  DSKCHN,FILBL2	;TRY FOR MUSAA.DMD

	JRST	[MESSAGE[ASCIZ/
		*** MUSIC FILE NOT FOUND/]
		CALLI  12]
        ;EXIT IF FILE IS MISSING
	MOVE A,FILBL2+3	;GET LENGTH OF MUSAA.DMD
	MOVEM A,FILBLK+3;PUT IT IN RIGHT PLACE

XOPEN:	OPEN	ADCHN,[117 	;MODE
         	'AD    '        ;DEVICE NAME
 		0]              ;NO BUFFER HEADERS

  	JRST	[MESSAGE[ASCIZ/
		***D-A NOT AVAILABLE/]
		CALLI  12]
	;EXIT IF D-A IS UNAVAILABLE

SPWAR:	SPCWAR 17,[CALLI]
	MESSAGE [ASCIZ/ GO? /]
	READCH A


LNTH:	movs a,filblk+3		;get length of file.
	movnm a,nwd

;	-----------------------------------------

	;BEGIN MAIN BODY OF PROGRAM

LOOP:	JSP	RET,SUB		;ROUTINE TO READ AND WRITE
;;	BUF1-1 			;USE BUF1 FOR THE I/O
	0
	JUMPLE	B,OUT    	;DONE
	
	JSP	RET,SUB		;CALL IT AGAIN
;;	BUF2-1			;USE BUF2 FOR THE I/O
	0
	JUMPG	B,LOOP		;GO BACK FOR MORE IF B>0

OUT:	close dskchn,		;END OF PROGRAM.
	releas adchn,
	SPCWAR 0,'SSW'
	jrst lx

	;SUBROUTINE TO SET UP IOWD AND READ AND WRITE.
	;  1(RET) WILL BE THE RETURN
	;  0(RET) WILL BE THE ADDRESS OF THE BUFFER TO BE
	;         PUT IN THE RIGHT HALF OF THE IOWD.
	;  A      WILL BE A WORK REGISTER
    	;  B      WILL BE TESTED ON THE OUTSIDE.

SUB:	MOVNI	A,BUFSIZ	;PICK UP AND COMPLEMENT BUFSIZ
	ADDB	A,NWD		;A←NWD-BUFSIZ
				;NWD←NWD-BUFSIZ
	MOVE	B,A		;SAVE B TO BE TESTED FOR LAST
				;TIME.
	JUMPL	A,LAST		;SET UP FOR LAST TIME.
	MOVEI	A,0		

	;THE IOWD LOOKS LIKE:
	;  [-BUFSIZ / BUFI-1]

LAST:	ADDI	A,BUFSIZ
	MOVNS	A		;COMPLEMENT A
	HRL	A,0(RET)	;PICK UP BUFI AND MOVE IT
				;TO THE LEFT SIDE OF A.
	MOVSM	A,INLIST	;SWAP A AND MOVE IT.
	MOVSM	A,OUTWC		;SAME FOR OUTPUT.
	INPUT	DSKCHN,INLIST	;READ A RECORD.
	OUTPUT	ADCHN,OUTWC	;WRITE THE RECORD.
	JRST	1(RET)		;RETURN

;	-----------------------------------------

; STORAGE:

NWD:	0			;FOR NUMBER OF WORDS OF INPUT.
;;↓BUF1:	BLOCK	BUFSIZ+1	;BUFFER 1
;;BUF2:	BLOCK	BUFSIZ+1	;BUFFER 2

FILBLK: 'MUSIC '		;FILENAME FOR INPUT
	'MUS   '			;EXTENSION
	0			;INFORMATION ON FILE
	0			;PROJECT PROG#

FILBL2: 'MUSAA '		;FILENAME FOR INPUT, 2ND CHOICE
	'DMD   '			;EXTENSION
	0			;INFORMATION ON FILE
	0			;PROJECT PROG#

CLIST:	IOWD	1,NWD		;FOR THE FIRST RECORD
	0

INLIST:	0			;WILL CONTAIN AN IOWD
	0

OUTWC:	0			;WILL CONTAIN AN IOWD FOR D-A
	3650			;MAGIC BITS FOR 136.
OUTBIT: 4000			;BITS FOR D-A
	BLOCK	2

begin magdsk

A←1
B←2
D←3
OLNG←=2432	;size of mag tape records. must be multiple of =128.

ILNG←=2432
ichn←adchn
ochn←dskchn
↑START:	CALLI 0
	INIT ICHN,3B28+17
	SIXBIT /MTA0/
	0
	HALT
	MTAPE ICHN,1	;REWIND THE TAPE
	JFCL
	INIT OCHN,17
	SIXBIT /DSK/
	0
	HALT
	ENTER OCHN,[SIXBIT /MUSIC/
                    SIXBIT /MUS/
	            0
	            0]
	HALT
	loop:input ichn,olst
		statz ichn,20000
		jrst out	;end of tape.
		output ochn,olst
		jrst loop
OLST:	IOWD OLNG,OBUF
	0
obuf←← buf1
	bend magdsk

end beg
ENTRY CORGET,CORREL,FSINIT
TITLE CORGET
INTERNAL FSINIT,CORGET,CORREL
EXTERNAL JOBREL,JOBSA,JOBFF,JOBDDT,JOBSYM

THIS←2
SIZ←3
NEXT←4
PREV←5
LAST←6
USER←7
TEMP←10
P←17

INTEGER TOP,FRELST,LOWC
TRIVIAL←←5
ARRAY BUFACS[20]

DEFINE TERPRI(A) <
	PUSHJ P,[
		OUTSTR [ASCIZ /A
/]
		JRST 4,CPOPJ]
>

DEFINE ERR(A) <
	OUTSTR [ASCIZ /A
/]
>
; UTILITY ROUTINES. SAVE AND GET ACCUMULATORS

FSINIT:	MOVEI	TEMP,-1		;FOR MAX CORE 
	MOVEM	TEMP,JOBFF	; IS DOING
	HLRZ	USER,JOBSA
	SKIPN	JOBDDT		;IF DDT IS IN CORE,
	 JRST	 NODDT		; MAKE SURE ITS SYMBOLS ARE PROTECTED
	HRRZ	TEMP,JOBSYM	;IF JOBSYM IS BELOW JOBFF, THEN 
	CAML	TEMP,USER	; ASSUME ALL SYMBOLS ARE BELOW.
	 TERPRI	 <YOUR SYMBOLS ARE SOON TO BE OBLITERATED>


NODDT:	SETZM	FRELST		; CLEAR POINTERS
	SETZM	TOP
	MOVEI	THIS,(USER)
	MOVEM	THIS,LOWC	; SET BOTTOM OF CORE
	PUSHJ	P,NEWBLK	;MAKE NEW AREA INTO A FREE BLOCK
	JRST	JUSTSAVE	;SAVE ACS

NEWBLK:	
	HRRZ	LAST,JOBREL	;END OF BIG BLOCK
NEWB1:	SETZM	(THIS)		;POINTERS WORD IN BIG BLOCK
	ADDI	LAST,1		;CONFORM TO "LAST" STANDARDS
	MOVEM	LAST,TOP	;TOP OF FREE SPACE
	PUSH	P,SIZ		;SAVE SIZE
	MOVE	SIZ,LAST	;COMPUTE SIZE OF NEW BLOCK
	SUB	SIZ,THIS	;SIZE OF BIG BLOCK
	PUSHJ	P,RELINK	;PUT ON FREE STORAGE LIST
	POP	P,SIZ		;GET SIZ BACK
CPOPJ:	POPJ	P,


JUSTSAVE:
	MOVEM	TEMP,BUFACS+TEMP
	MOVEI	TEMP,BUFACS
	BLT	TEMP,BUFACS+LAST
	POPJ	P,

BUFRST:	MOVSI	TEMP,BUFACS
	BLT	TEMP,TEMP
	POPJ	P,
; ROUTINES TO LINK AND UNLINK A BLOCK INTO THE FREE LIST
; CALL WITH ADDRESS IN THIS AND SIZE IN SIZ

UNLINK:	
	HRRZ	NEXT,(THIS)	;→NEXT BLOCK
	HLRZ	PREV,(THIS)	;→PREVIOUS BLOCK
	SKIPN	PREV		;IF A PREV BLOCK DOES NOT EXIST,
	 MOVEI	 PREV,FRELST	; USE FRELST POINTER
	HRRM	NEXT,(PREV)	;CHANGE ITS NEXT FIELD
	SKIPE	NEXT		;IF A NEXT BLOCK EXISTS,
	 HRLM	 PREV,(NEXT)	; CHANGE ITS PREV FIELD
	POPJ	P,		;BLOCK IN "THIS" IS NO LONGER ON FRELST

RELINK:
	HRRZM	THIS,-1(LAST)	;X-BIT ← 0, RH ← PTR TO HEAD
	MOVEM	SIZ,1(THIS)	;GREATER 0 SIZE FIELD ⊃ FREE BLOCK
	SKIPE	NEXT,FRELST	;PLACE NEW BLOCK ON FRONT OF FRELST
	 HRLM	 THIS,(NEXT)	; IF THERE IS ONE
	HRRZM	NEXT,(THIS)	;POINT TO NEXT FROM THIS
	HRRZM	THIS,FRELST	;UPDATE FRELST POINTER
	POPJ	P,		;RETURN
; ROUTINE TO GET CORE
; CALL WITH SIZE IN AC 3
; RETURNS BLOCK IN 2
; SAVES ALL ACCUMULATORS

CORGET:
	PUSHJ	P,JUSTSAV	;SAVE AC'S, INITIALIZE WORLD PERHAPS


COR21:	ADDI	SIZ,3		;3 WORDS FOR CONTROL INFO
	MOVEI	THIS,FRELST	;THIS WILL POINT TO THE FIRST GOOD BLOCK

GETLUP:	HRRZ	THIS,(THIS)	;→NEXT FREE BLOCK
	JUMPE	THIS,EXPAND	;TRY TO EXPAND CORE, NONE EXIST YET
	CAMLE	SIZ,1(THIS)	;WILL IT FIT?
	 JRST	 GETLUP		; NO, TRY NEXT

GETCOR:	AOS	(P)		;SUCCESS GUARANTEED
	HRRZM	THIS,BUFACS+THIS ;RESULT(ALMOST)
	PUSHJ	P,UNLINK	;UNLINK THIS BLOCK
	MOVE	LAST,1(THIS)	;REAL BLOCK SIZE
	CAIGE	LAST,TRIVIAL(SIZ) ;IS DIFFERENCE NEGLIGIBLE?
	 JRST	 [MOVSI TEMP,400000 ;YES, USE WHOLE THING --
		  ADD   LAST,THIS ; MARK X-BIT TO INDICATE IN USE
		  HLLM	TEMP,-1(LAST)
		  JRST	GETOUT]	;AND GO FINISH OUT

	MOVEM	SIZ,1(THIS)	;NEW SIZE FOR RESULT
	HRRZ	TEMP,THIS	;SAVE START OF BLOCK (RESULT)
	ADD	THIS,SIZ	;NEW START FOR REMAINING FREE STUFF
	SUB	LAST,SIZ	;NEW SIZE FOR REMAINS
	MOVE	SIZ,LAST
	ADD	LAST,THIS	;NEW END FOR REMAINS
	HRLI	TEMP,400000	;TURN X-BIT ON
	MOVEM	TEMP,-1(THIS)	;IN USER'S BRAND NEW BLOCK
	PUSHJ	P,RELINK	;RELINK REMAINS, RESTORE ACS


GETOUT:	PUSHJ	P,BUFRST	;RESTORE ACS
	SETZM	(THIS)		;PTR RETRIEVED FROM STORAGE
	MOVNS	1(THIS)		;SIZE NEG ⊃ IN USE
	ADDI	THIS,2		;USER DOESN'T SEE THIS HEADER
	POPJ	P,		;HERE'S YOUR BLOCK!
; HERE WE INCREASE THE JOB CORE SIZE

EXPAND:	PUSH	P,SIZ		;SAVE TOTAL SIZE
	HRRZ	THIS,TOP	;THIS→NEW BLOCK IF NEXT LOWER IS USED
	SKIPGE	-1(THIS)	;IS TOP BLOCK FREE?
	 JRST	 GETMOR		; NO, USE WHAT YOU HAVE
	HRRZ	THIS,-1(THIS)	;UNLINK THE
	PUSHJ	P,UNLINK	; TOP BLOCK

GETMOR:	MOVE	TEMP,THIS
	ADDI	TEMP,=1024(SIZ)	;GET MORE AND THEN SOME
	POP	P,SIZ		;GET THIS BACK BEFORE YOU FORGET
	CALL	TEMP,[SIXBIT /CORE/]	;ASK FOR MORE
	 JRST	 BUFRST		;CAN'T GET IT
	PUSHJ	P,NEWBLK	;MAKE TOP LOOK LIKE FREE BLOCK
	CAMLE	SIZ,1(THIS)	;NOW SHOULD FIT
	 ERR	 <DRYROT -- EXPAND CODE GLUBBED UP>
	JRST	GETCOR
; ROUTINE TO RELEASE CORE, ENTER WITH BLOCK ADDRESS IN 2

CORREL:
	PUSHJ	P,JUSTSAVE	;SAVE ACS

; MERGE WITH LOWER NEIGHBOR (ADDRESS-WISE) IF POSSIBLE

	SUBI	THIS,2		;USER THINKS IT STARTED 2 PAST
	MOVN	SIZ,1(THIS)	;SIZE OF THIS BLOCK
	MOVE	LAST,SIZ	;ADDRESS OF UPPER
	ADD	LAST,THIS	;  NEIGHBOR

	CAMGE	THIS,LOWC	;IS ADDRESS IN RANGE?
	 ERR	 <DRYROT -- BAD ADDRESS TO BUFREL>
	CAME	THIS,LOWC	;CAN THERE BE A LOWER BLOCK
	SKIPGE	-1(THIS)	; AND IF SO, IS IT FREE?
	 JRST	 UPPET		; NO, LOOK FOR UPPER BLOCK

	HRRZ	THIS,-1(THIS)	;→LOWER BLOCK
	PUSHJ	P,UNLINK	;UNLINK IT FROM LIST
	ADD	SIZ,1(THIS)	;INCREASE SIZE
	
; MERGE WITH UPPER NEIGHBOR IF POSSIBLE

UPPET:	CAMLE	LAST,TOP
	 ERR	 <YOU ARE ABOUT TO GET AN ILL MEM-REF>

	CAME	LAST,TOP	;IS THERE AN UPPER BLOCK?
	SKIPGE	1(LAST)		;AND IF SO, IS IT FREE?
	 JRST	 LNKRET		; NO, RELINK AND GO AWAY

UPPR:	PUSH	P,THIS
	HRRZ	THIS,LAST	;THIS → UPPER NEIGHBOR
	PUSHJ	P,UNLINK	;GET IT OUT
	ADD	LAST,1(THIS)	; INCREASE EXTENT
	ADD	SIZ,1(THIS)	; AND TOTAL SIZE
	POP	P,THIS		; GET HEADER POINTER BACK
; HERE WE TRY TO SHRINK CORE

LNKRET:	
	CAMG	LAST,JOBREL	;THIS IS THE LAST CORE BLOCK, AND
	 JRST	 LNKRT
	CAIGE	SIZ,=2046	; IT IS MORE THAN 2K LONG,
	 JRST	 LNKRT
	MOVEI	TEMP,=2046(THIS) ;THEN 1) SHRINK CORE TO 2K FOR LAST BLOCK
	CALL	TEMP,[SIXBIT /CORE/]
	 ERR	 <DRYROT --CORSER&LNKRET>
	MOVE	LAST,JOBREL	; AND  2) ADJUST BLOCK TO INDICATE
	ADDI	LAST,1
	MOVEM	LAST,TOP	;AND RECORD NEW RESULTS.
	MOVE	SIZ,LAST	;THE CHANGE BEFORE RELINKING
	SUB	SIZ,THIS
LNKRT:
	PUSHJ	P,RELINK	;PUT IT BACK
	JRST	BUFRST		;AND GO AWAY

END